home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 21 / AACD 21.iso / AACD / Programming / amigatalk / general / Object.st < prev    next >
Encoding:
Text File  |  2001-02-27  |  4.3 KB  |  171 lines
  1. "-----------------------------------------------------------------"
  2. " Object Class is the Root of all other Classes in AmigaTalk.     "
  3. "-----------------------------------------------------------------"
  4.  
  5. Class Object             "! methods variables !"
  6. [
  7.     == anObject
  8.       ^ <primitive 7 self anObject >
  9. |
  10.     ~~ x
  11.       ^ (self == x) not
  12. |
  13.     = x
  14.       ^ (self == x)              "Is the receiver equal to x??"
  15. |
  16.     ~= x
  17.       ^ (self = x) not           "Is the receiver NOT equal to x??"
  18. |
  19.     asString
  20.       ^ <primitive 152 (self class)> "Avoid recursion!"
  21.  
  22.       "^ self class printString" "<<--Infinite recursive method."
  23. |
  24.     asSymbol
  25.       ^ self asString asSymbol   "Return the class as a Symbol."
  26. |
  27.     yourself                     "Synonym for self."
  28.       ^ self
  29. |
  30.     class
  31.       ^ <primitive 1 self >
  32. |
  33.     copy
  34.       ^ self shallowCopy
  35. |
  36.     deepCopy  ! size newobj !
  37.       size <- <primitive 4 self>.
  38.  
  39.       (size < 0) 
  40.           ifTrue: [^ self] "if special just copy object"
  41.          ifFalse: [ newobj <- self class new.
  42.  
  43.       (1 to: size) do: [:i |
  44.             <primitive 112 newobj i ( <primitive 111 self i > copy ) > ].
  45.             ^ newobj ]
  46. |
  47.     do: aBlock     ! item !
  48.       item <- self first.
  49.  
  50.       ^ [item notNil] whileTrue:
  51.                       [aBlock value: item.  item <- self next]
  52. |
  53.     error: aString
  54.       <primitive 122 aString self>
  55. |
  56.     first
  57.       ^ self
  58. |
  59.     isKindOf: aClass ! objectClass !
  60.       objectClass <- self class.
  61.  
  62.       [objectClass notNil] whileTrue:
  63.              [(objectClass == aClass) ifTrue: [^ true].
  64.  
  65.                  objectClass <- objectClass superClass].
  66.       ^ false
  67. |
  68.     isMemberOf: aClass
  69.        ^ aClass == self class
  70. |
  71.     isNil
  72.        ^ false
  73. |
  74.     next
  75.        ^ nil
  76. |
  77.     notNil
  78.        ^ true
  79. |
  80.     print
  81.        <primitive 121 (self printString)>
  82. |
  83.     printNoReturn
  84.        <primitive 120 (self printString)>
  85. |
  86.     printString
  87.        ^ self asString
  88. |    
  89.     respondsTo: cmd
  90.        ^ self class respondsTo: cmd
  91. |    
  92.     shallowCopy ! size newobj !
  93.        size <- <primitive 4 self>.
  94.  
  95.        (size < 0) 
  96.          ifTrue: [^ self] "if special just copy object"
  97.          ifFalse: [ newobj <- self class new.
  98.  
  99.        (1 to: size) do: [:i |
  100.                <primitive 112 newobj i <primitive 111 self i > > ].
  101.  
  102.                           ^ newobj ]
  103. |
  104.    subclassResponsibility: methodString ! msg !
  105.      msg <- String new: 'Method ',methodString,' should be implemented in a SubClass!'.
  106.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  107. |
  108.    notImplemented: methodString ! msg ! 
  109.      msg <- String new: 'Method ',methodString,' NOT implemented!'.
  110.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  111. |
  112.    doesNotUnderstand: methodString ! msg !
  113.      msg <- String new: 'Method ',methodString,' NOT understood!'.
  114.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'> 
  115. |
  116.    shouldNotImplement: methodString ! msg !
  117.      msg <- String new: 'Method ',methodString,' should NOT BE implemented!'.
  118.      ^ <primitive 181 13 msg 'User ERROR:' 'OKAY'>
  119. |
  120.    in: object at: index put: value
  121.      "Change data field in object, used during initialization."
  122.      "Returns the intialized object (from LittleSmalltalk V4.0)."
  123.  
  124.      ^ <primitive 112 object index value>
  125. "
  126. |
  127.    instanceVariables  ! names ! "return all our variable names"
  128.      ((super class) notNil)
  129.         ifTrue:  [ names <- (super class) instanceVariables ]
  130.         ifFalse: [ names <- Array new: 0 ].
  131.  
  132.      (variables isNil or: [ variables isEmpty ])
  133.         ifFalse: [ names <- names + variables ].
  134.  
  135.    ^ names
  136. |
  137.    parseMethod: text ! newparser !
  138.    
  139.      newparser <- Parser new.
  140.     
  141.      ^ ((newparser text: text instanceVars: self instanceVariables) 
  142.          parse: self)
  143. |
  144.    addMethod ! text !
  145.  
  146.      text <- (' ' edit).
  147. "
  148.      "smalltalk newIO: 'Enter yes or no:' title: 'Compile Method??'.
  149.       ((smalltalk getString) = 'yes')
  150.          ifTrue: [ ^ (self addMethod: text) ]
  151.  
  152.       (self question: 'compile method?')
  153.          ifTrue: [ ^ (self addMethod: text) ]
  154.      "
  155. "   
  156.      ^ (self addMethod: text)
  157. |
  158.    addMethod: text ! meth !
  159.      meth <- (self parseMethod: text).
  160.  
  161.      (meth notNil)
  162.         ifTrue: [ (methods == nil)
  163.                     ifTrue: [ methods <- Dictionary new ]. 
  164.         
  165.                   methods at: (meth name) put: meth. 
  166.  
  167.                   ^ ('method inserted: ', (meth name) printString) 
  168.                 ]
  169. "
  170. ]
  171.